CD Ware Multimedia 1995 May/cd Ware (Juegos) Epimundo.iso/DOS/PRGMMING/M2PROTOS.ZIP/PATHFIND.MOD

Modula Implementation | 1991-02-09 | 5.5 KB | 211 lines

(*%F _fdata *)
(*# call(seg_name => null) *)
(*%E *)
(*# module(implementation=>off) *)
(*# data(seg_name => null) *)
(*# call(o_a_copy => off) *)
(*# check(stack=>off,
          index=>off,
          range=>off,
          overflow=>off,
          nil_ptr=>off) *)
IMPLEMENTATION MODULE PathFind;

(* Source code for JPI TopSpeed Modula-2 by

    Carl Neiburger
    169 N. 25th St.
    San Jose, Calif. 95116

    CompuServe No. 72336,2257

NOTE: This module requires MODULE FioAsm by the same author.  If you can't
find this module, you can write your own routines for this procedure:

PROCEDURE Drives(): SHORTCARD;
    (* tells how many on system *)

    NFIO is a substitute for JPI's FIO, and all the imported procedures
       listed here work the same as in FIO
*)

FROM Lib IMPORT Environment, CommandType;
FROM Str IMPORT Append, Caps, CHARSET, Copy, Delete, Item, Length, Pos,
         Slice, Concat, Compare;
FROM NFIO IMPORT GetDir, ChDir, OK, Exists;
FROM FioAsm IMPORT Drives, ReadFirstEntry, ReadNextEntry,
         FileAttributes, DirEntry, FileAttr;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;

CONST
    FileOrDir = FileAttr{readonly,directory};

TYPE str80 = ARRAY [0..79] OF CHAR;

PROCEDURE FindEnvStr( target : ARRAY OF CHAR; VAR string: ARRAY OF CHAR );
VAR i : CARDINAL; c : CommandType;
BEGIN
    i := 0;
    REPEAT
         c := Environment(i);
         Copy(string, c^ );
         Caps(string);
         INC(i)
    UNTIL ( string[0] = 0C ) OR ( Pos(string, target ) < MAX( CARDINAL ) );
    i := Pos(string, '=');
    IF i < MAX ( CARDINAL ) THEN
         Delete(string, 0, i+1);
         WHILE string[0] IN CHARSET{11C, 40C} DO
              Delete(string, 0, 1)
         END
    END
END FindEnvStr;

PROCEDURE FindPath(PathName,
                   TargetName: ARRAY OF CHAR;
               VAR TargetPath: ARRAY OF CHAR): BOOLEAN;

VAR path: str80; item: PathStr;  i : CARDINAL;
BEGIN
    IF Exists( TargetName ) THEN
         Copy(TargetPath, TargetName);
         RETURN TRUE
    END;
    FindEnvStr( PathName, path );
    i := 0;
    LOOP
         Item( item, path, CHARSET{';'}, i);
         IF item[0] = 0C THEN
              Copy(TargetPath, TargetName);
              RETURN FALSE
         END;
         IF NOT ( item[Length(item)-1] IN CHARSET{':', '\'} ) THEN
              Append( item, '\' );
         END;
         Append( item, TargetName );
         IF Exists( item ) THEN
              Copy(TargetPath, item);
              RETURN TRUE;
         END;
         INC ( i )
    END;
END FindPath;

PROCEDURE ParsePath(VAR Path: PathStr;
                    VAR FileName: PathTail): BOOLEAN;
VAR DE: DirEntry;
    Len: CARDINAL;
    Parent,
    PathOnly : BOOLEAN;
    CurrentPath : PathStr;

PROCEDURE CompletePath(): BOOLEAN;
VAR SavePath: PathStr; d : SHORTCARD;
BEGIN
    IF Path[1] = ':' THEN
         d := SHORTCARD(CAP(Path[0])) - 64;
         IF d > Drives() THEN
              RETURN FALSE
         END
    ELSE
         d := 0
    END;
    GetDir(0, SavePath);
    IF Path[0] = 0C THEN
         Path := SavePath;
         RETURN TRUE
    END;
    ChDir ( Path );
    IF OK THEN
         GetDir( d, Path );
         ChDir( SavePath );
         RETURN TRUE
    END;
    RETURN FALSE
END CompletePath;

PROCEDURE SlicePath;
VAR i: CARDINAL;
BEGIN
    i := Len;
    WHILE NOT (Path[i] IN CHARSET{':', '\'}) AND (i > 0) DO
         DEC(i)
    END;
    IF (i = Len) AND (Path[i] IN CHARSET{':', '\', '.'}) THEN
         PathOnly := TRUE;
         RETURN
    ELSE
         PathOnly := FALSE
    END;
    IF i = 0 THEN
         Copy(FileName, Path);
         Path[0] := 0C;
         RETURN
    END;
    Slice(FileName, Path, i+1, Len );
    IF (Path[i] = ':') OR (Path[i-1] = ':') THEN
         INC(i);
    END;
    Path[i] := 0C;
END SlicePath;

BEGIN (* ParsePath *)
    Len := Length(Path) - 1;
    Caps(Path);
    Caps(FileName);
    Parent := Compare(Path, '..') = 0;
    IF Parent THEN
         GetDir( 0, CurrentPath );
         Parent := Length(CurrentPath) > 3
    END;
    IF Parent OR ReadFirstEntry( Path, FileOrDir, DE ) THEN
         IF (Pos(Path, '*') < MAX(CARDINAL) )
            OR (Pos(Path, '?') < MAX(CARDINAL) )
            OR NOT ( Parent OR (directory IN DE.attr) ) THEN
              SlicePath;
         END;
         RETURN CompletePath()
    END;
    SlicePath;
    RETURN CompletePath() AND PathOnly (* RETURN FALSE if file not found *)
END ParsePath;

PROCEDURE FileTree ( Path: PathStr ): FilePtr;
VAR Ptr, this: FilePtr; p: PathStr; FileName: PathTail; DE: DirEntry;
BEGIN
    FileName := '*.*';
    IF ParsePath( Path, FileName) THEN
         IF Path[Length(Path)-1] <> '\' THEN
              Append( Path, '\')
         END;
         Concat( p, Path, FileName);
         IF ReadFirstEntry( p, FileAttr{readonly}, DE ) THEN
              NEW(this);
              Concat(this^.Name, Path, DE.Name);
              this^.Next := NIL;
              Ptr := this;
              WHILE ReadNextEntry( DE ) DO
                   NEW(this^.Next);
                   this := this^.Next;
                   Concat(this^.Name, Path, DE.Name);
                   this^.Next := NIL
              END;
              RETURN Ptr
         END
    END;
    RETURN NIL;
END FileTree;

PROCEDURE UnFileTree ( VAR Ptr : FilePtr );
VAR this: FilePtr;
BEGIN;
    this := Ptr;
    WHILE this <> NIL DO
         Ptr := Ptr^.Next;
         DISPOSE(this);
         this := Ptr
    END
END UnFileTree;

END PathFind.